COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	entry
C00017 ENDMK
C⊗;
entry;
begin  "grafix"
  
  comment  August 2, 1978 .

  This module implements routines to handle graphics on the
  Tektronix terminal. Every attempt is made to provide routines
  that are device-independent.  The following is the prescription
  for producing displays. 
    clipinit  begindisplay  'display'  endisplay
  endcomment;

  comment   March 14, 1979

  This module has been updated to run at Stanford if the macro
  variable "STANFORD" is true. All attempts have been made to keep
  the changes as minimal as possible.

	Michael R. Lowry
  endcomment;

  define STANFORD="true";

  require  "define.sai"  source!file;
  IFC STANFORD THENC
  require  "grapin.sai"  source!file;
  ELSEC
  require  "gabbrv.sai"  source!file;
  ENDC

  integer  rbeg, cbeg;  ! Top left-hand corner of window to be
			displayed;
  integer  rend, cend;	! Bottom right-hand corner of window;
  integer  rwsz, cwsz;  ! Window size;
  integer  rowsz, colsz;	! Size of picture;
  integer  curr, curc;	! current position of cursor on the screen;
  integer  size;	! size defining the window;
  boolean  vectors;	! whether or not to draw st lines with 
			  arrow heads;
  real  arrowlength;	! length of the arrowheads;


  STRING  S;
  DEFINE  CLIPCHECK = "FALSE";

  internal  simple  procedure  resetwindow;
  ! Procedure to set the screen. Assumes correct size
    parameters in the variables rbeg, cbeg, rend, cend, and
    size.;
  vwindo(cbeg*1.0,size*1.33,-rend*1.0,size*1.0);

  internal  simple  boolean  procedure  rcok(integer r, c);
  ! Checks whether a point is within the window.;
  return(rbeg <= r <= rend and cbeg <= c <= cend);

  internal  simple  procedure  clipdsp(integer  r1, c1, r2, c2);
  begin  "clip"
  integer  cd1, cd2;
  real  theta, rrp, ccp, rrm, ccm;	! variables for displaying
					  arrow heads;
  integer  nswap;	! No of times swapping is done;
  
  ! Produces a clipped line inside the window. This same 
    implementation is given in 
    Newmann & Sproull, Principles of Interactive Computer Graphics,
    McGraw-Hill, 1973, p.124.;

    simple  integer  procedure  code(integer r, c);
    return(( if r < rbeg then '01 else (if r > rend then '10 else 0)) +
      (if c < cbeg then '100 else (if c > cend then '1000 else 0)));

    cd1 := code(r1,c1);  cd2 := code(r2,c2);  nswap := 0;
    IFC  CLIPCHECK  THENC
    PRINT("CODES",CD1," ",CD2,CRLF);
    s := INTTY;  ENDC
    while  not(cd1 = cd2 = 0)  do
    begin
      IFC  CLIPCHECK  THENC
      IF  CD1 LAND CD2  THEN
      PRINT(" NOT VISIBLE",R1," ",C1," ",R2," ",C2,CRLF);
      s := INTTY;  ENDC
      if  cd1 land cd2  then  return;
      if  cd1 = 0  then  
      begin
        cd1 swap cd2;  r1 swap r2;  c1 swap c2;  nswap := nswap + 1;
      end;
      if  cd1 land '1  then
      begin
        c1 := c1 + (c2-c1)*(rbeg-r1)/(r2-r1);  r1 := rbeg;
      end  else
      if  cd1 land '10  then
      begin
        c1 := c1 + (c2-c1)*(rend-r1)/(r2-r1);  r1 := rend;
      end  else
      if  cd1 land '100  then
      begin
        r1 :=  r1 + (r2-r1)*(cbeg-c1)/(c2-c1);  c1 := cbeg;
      end  else
      if  cd1 land '1000  then
      begin
        r1 :=  r1 + (r2-r1)*(cend-c1)/(c2-c1);  c1 := cend;
      end;
      cd1 := code(r1,c1);
    end;

    IFC  CLIPCHECK  THENC
    PRINT(" CLIPPED LINE",R1," ",C1," TO ",R2," ",C2,CRLF);
    s := INTTY;
    ELSEC
      movea(1.0*c1,-1.0*r1);  drawa(1.0*c2,-1.0*r2);
      if  vectors  then
      begin
        if  not even(nswap)  then
        begin
          r1 swap r2;  c1 swap c2;
        end;
        theta := myatan(c2-c1,r2-r1);
        rrp := cosd(theta+135) * arrowlength;
        ccp := sind(theta+135) * arrowlength;
        rrm := - ccp;  ccm := rrp;
        drawa(1.0*(c2+ccp),-1.0*(r2+rrp));
        movea(1.0*(c2+ccm),-1.0*(r2+rrm));
        drawa(1.0*c2,-1.0*r2);
      end;
    ENDC
  end  "clip" ;

  internal  sIMPLE PROCEDURE ARDSTR(STRING sTR);
    IFC STANFORD THENC
    begin
	putext(str);
    end;

    ELSEC
    BEGIN
    INTEGER I,CHA;
    FOR I←1 sTEP 1 UNTIL LENGTH(STR) DO
	BEGIN CHA←STR[I FOR 1];
	IF CHA='12 THEN LINEF ELSE IF CHA='15 THEN CARTN
	    ELSE ANCHO(CHA);
	END;
    END;
    ENDC

  internal  simple  procedure  dcrlf;
  begin
  ! Produces an equivalent of carriage-return and line-feed for
    alphameric display.;
    curc ← cbeg;
    curr := curr + (3*size)/100;
    movea(1.0*curc,-1.0*curr);
  end;

  internal  simple  procedure  movecursor(integer r, c);
  begin
  ! Moves cursor on the screen to the designated point.;
    curr := r;  curc := c;  movea(1.0*c,-1.0*r);
  end;

  INTERnal  simple  procedure  legend(string pic);
  begin
  integer  sz;
  ! Procedure to produce a legend on the Tektronix terminal.
    The legend is produced in the upper right-hand corner of the
    screen.;
    sz := 100;  curr := 5;  curc := 76;
    vwindo(0.0,1.0*sz,-1.0*sz,1.0*sz);
    movecursor(curr,curc);  ardstr(pic);  dcrlf;  dcrlf;
    ardstr("top left corner: ");  dcrlf;  
    ardstr(cvs(rbeg)&" "&cvs(cbeg));  dcrlf;  dcrlf;
    ardstr("window: ");  dcrlf;
    ardstr(cvs(rwsz)&" X "&cvs(cwsz));  dcrlf;  dcrlf;
  end;

  internal  simple  procedure  linelegend(string s);
  begin
  ! Produces a single line of legend, whatever it may be.;
    ardstr(s);  dcrlf;
  end;

  simple  procedure  border;
  begin
  ! Bordering the picture on the terminal screen.;
  ! produces border on the terminal;
      movea(1.0*cbeg,-1.0*rbeg);
      drawa(1.0*cbeg,-1.0*rend);
      drawa(1.0*cend,-1.0*rend);
      drawa(1.0*cend,-1.0*rbeg);
      drawa(1.0*cbeg,-1.0*rbeg);
  end;

  internal  simple  procedure  cliptest;
  begin
  ! Procedure to test 
		procedure clipdsp
    defined above.;
  integer  r1, c1, r2, c2;
    iprmpt(" rbeg",rbeg);  iprmpt(" rend",rend);
    iprmpt(" cbeg",cbeg);  iprmpt(" cend",cend);
    do  begin
      iprmpt(" r1",r1);  iprmpt(" c1",c1);
      iprmpt(" r2",r2);  iprmpt(" c2",c2);
      clipdsp(r1,c1,r2,c2);
      print(r1," ",c1," ",r2," ",c2," ",crlf);
    end  until  false;
  end;

  internal  simple  procedure  clipinit(integer r, c);
  begin
  ! Initialising this module.;
    rowsz := r;  colsz := c;  rbeg := 1;  cbeg := 1;
    size := r;  if  c > size  then  size := c;
    rwsz := r;  cwsz := c;  rend := r;  cend := c;
    vectors := false;
  end;

  simple  procedure  graphicswindow;
  begin
    do  begin
      print(" specify window.",crlf);
      iprmpt(" row begin",rbeg);  iprmpt(" col begin",cbeg);
      rwsz := rowsz - rbeg + 1;  cwsz := colsz - cbeg+ 1;
      iprmpt(" no of rows",rwsz);  iprmpt(" no of cols",cwsz);
      rend := rbeg + rwsz - 1;  cend := cbeg + cwsz - 1;
    end  until  1 <= rbeg <= rowsz and 1 <= rend <= rowsz 
           and  1 <= cbeg <= colsz and 1 <= cend <= colsz;
    size := rwsz;  if  cwsz > rwsz  then  size := cwsz;
    arrowlength := size/128.0;
  end;

  simple  procedure  startdisplay;
  begin
  ! Make sure you set up the size parameters all right ;
    pctr(0);  initt(450);
    resetwindow;  border;
    movecursor(rbeg,rend);
  end;

  internal  simple  procedure  endisplay;
  begin
    linelegend(date);  linelegend(ttime);
    movecursor(rend,cend);
  endpct;
  end;

  internal  simple  procedure  dashedline(integer fr,fc,tr,tc);
  begin
  ! Given from and to coordinates, produces a dashed line.;
    movea(1.0*fc,-1.0*fr);  dasha(1.0*tr,-1.0*tc);
    curr := tr;  curc := tc;
  end;

  internal  simple  procedure  begindisplay;
  begin
    bprmpt(" Vectors ?",vectors);
    graphicswindow;  startdisplay;
  end;

  internal  simple  procedure  drawline(integer r, c);
  begin
  ! Draws a line from wherever the cursor is to the point 
    specified. Cursoris moved also;
    clipdsp(curr,curc,r,c);  curr := r;  curc := c;
  end;

  INTERnal  simple  procedure  dispid(integer id, r, c);
  begin
  ! Displays an integer at the given coordinates.;
    if  rcok(r,c)  then
    begin
      movecursor(r,c);  ardstr(cvs(id));
    end;
  end;

  internal  simple  procedure  clipoint(integer r,c);
  begin
  ! displays a point, if within the window.;
  if  rcok(r,c)  then  
	    pointa(1.0*c,-1.0*r);
  end;

  internal  simple  procedure  getwindow(reference integer r1,c1,r2,c2);
  begin
  ! Returns the top left-hand and bottom right-hand corners of the
  current window;
    r1 := rbeg;  c1 := cbeg;  r2 := rend;  c2 := cend;
  end;

  internal  simple  procedure  drawvectors;
  vectors := true;

  internal  simple  procedure  novectors;
  vectors := false;

end  "grafix";